home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 49 / Amiga Format CD49 (2000-01-17)(Future Publishing)(GB)(Track 1 of 3)[!][issue 2000-02].iso / -websites- / wirenet / files / thor26_arexx.lha / Rexx / ChessMaster3000.thor < prev    next >
Text File  |  1999-01-17  |  21KB  |  818 lines
  1. /* ChessMaster3000.thor by Troels Walsted Hansen
  2. ** $VER: ChessMaster3000.thor 1.21 (27.11.98)
  3. **
  4. ** 1.21: Fixed for use on TCP/IP systems by Maurizio Lotauro
  5. **
  6. ** An ARexx script for playing a game of chess against another THOR-
  7. ** user through messages on a BBS. Please refer to the included file
  8. ** ChessMaster3000.doc for detailed information.
  9. */
  10.  
  11. options results
  12.  
  13. /* needs THOR and bbsread.library functions */
  14.  
  15. p = ' ' || address() || ' ' || show('P',,)
  16. thorport = pos(' THOR.',p)
  17.  
  18. if thorport > 0 then thorport = word(substr(p,thorport+1),1)
  19. else
  20. do
  21.     say 'No THOR port found!'
  22.     exit 10
  23. end
  24.  
  25. if ~show('p', 'BBSREAD') then
  26. do
  27.     address command
  28.         "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
  29.         "WaitForPort BBSREAD"
  30. end
  31.  
  32. /* save out msgtext and determine whether to continue an old or start a new game */
  33.  
  34. address(thorport)
  35. THORTOFRONT
  36. SAVEMESSAGE CURRENT FILENAME '"T:ChessMaster3000.thor.temp"' NOHEADER NOANSI
  37.  
  38. if ~open(ifh, 'T:ChessMaster3000.thor.temp', R) then
  39. do
  40.     REQUESTNOTIFY TEXT '"Cannot open temporary file: T:ChessMaster3000.thor.temp"' BT '"_Ok"'
  41.     exit
  42. end
  43.  
  44. /*
  45. ***ChessMaster3000, round #1
  46. */
  47.  
  48. newgame = 0
  49. firstmove = 1
  50.  
  51. do until(pos('***ChessMaster3000', line) > 0)
  52.     if eof(ifh) then
  53.     do
  54.         REQUESTNOTIFY TEXT '"Message contains no ChessMaster3000 data!"' BT '"_Ok"'
  55.         REQUESTNOTIFY TEXT '"Start new game?"' BT '"_Yes|_No"'
  56.         if(rc = 0 & result = 1) then
  57.         do
  58.             call close(ifh)
  59.  
  60.             /* initiate variables */
  61.             call NewGame()
  62.  
  63.             firstmove = 1
  64.  
  65.             /* write all the data */
  66.             call WriteData()
  67.  
  68.             address(thorport)
  69.             SHOWTEXT 'T:ChessMaster3000.thor.temp'
  70.  
  71.             /* move first turn */
  72.             call PlayMove()
  73.  
  74.             firstmove = 0
  75.  
  76.             /* write all the data */
  77.             call WriteData()
  78.  
  79.             address(thorport)
  80.             SHOWTEXT 'T:ChessMaster3000.thor.temp'
  81.  
  82.             /* post the file */
  83.             call PostMsg()
  84.             signal exit
  85.         end
  86.         signal exit
  87.     end
  88.     line = readln(ifh)
  89. end
  90.  
  91. firstmove = 0
  92.  
  93. /* read the rest of the chess info */
  94.  
  95. call ReadData()
  96.  
  97. /* move the pieces etc. */
  98.  
  99. call PlayMove()
  100.  
  101. /* write all the data to a file */
  102.  
  103. call WriteData()
  104.  
  105. address(thorport)
  106. SHOWTEXT 'T:ChessMaster3000.thor.temp'
  107.  
  108. /* initiate all variables from message info */
  109.  
  110. address(thorport)
  111. CURRENTMSG stem MSG
  112.  
  113. address(bbsread)
  114. READBRMESSAGE bbsname '"'MSG.BBSNAME'"' confname '"'MSG.CONFNAME'"' msgnr '"'MSG.MSGNR'"' headstem HEAD textstem TEXT
  115.  
  116. EVENT.TYPE            = 1                    /* replymsg */
  117. EVENT.TONAME        = HEAD.FROMNAME
  118. EVENT.SUBJECT        = HEAD.SUBJECT
  119. EVENT.CONFERENCE    = MSG.CONFNAME
  120. EVENT.REFNR            = MSG.MSGNR
  121. EVENT.REFORGINALNR = HEAD.ORGINALNR
  122. EVENT.TOADDR      = HEAD.FROMADDR
  123.  
  124. /* Not needed?
  125. EVENT.REFID         = HEAD.REFID
  126. EVENT.TOADDR         = TEXT.REPLYADDR
  127. */
  128.  
  129. /* post the file as a reply to the current message */
  130.  
  131. call PostMsg()
  132. signal exit
  133.  
  134. NewGame:
  135.     /* initiate all variables otherwise read from the message text */
  136.  
  137.     roundnumber = 0
  138.     newgame = 1
  139.  
  140.     pos.1.8 = ' #C# '; pos.2.8 = ' #N# '; pos.3.8 = ' #B# '; pos.4.8 = ' #Q# '; pos.5.8 = ' #K# '; pos.6.8 = ' #B# '; pos.7.8 = ' #N# '; pos.8.8 = ' #C# '
  141.     pos.1.7 = ' #P# '; pos.2.7 = ' #P# '; pos.3.7 = ' #P# '; pos.4.7 = ' #P# '; pos.5.7 = ' #P# '; pos.6.7 = ' #P# '; pos.7.7 = ' #P# '; pos.8.7 = ' #P# '
  142.  
  143.     do y=6 to 3 by -1
  144.         do x=1 to 8
  145.             pos.x.y = '   '
  146.         end
  147.     end
  148.  
  149.     pos.1.2 = ' P '; pos.2.2 = ' P '; pos.3.2 = ' P '; pos.4.2 = ' P '; pos.5.2 = ' P '; pos.6.2 = ' P '; pos.7.2 = ' P '; pos.8.2 = ' P '
  150.     pos.1.1 = ' C '; pos.2.1 = ' N '; pos.3.1 = ' B '; pos.4.1 = ' Q '; pos.5.1 = ' K '; pos.6.1 = ' B '; pos.7.1 = ' N '; pos.8.1 = ' C '
  151.  
  152.     blacklosses = ''
  153.     whitelosses = ''
  154.  
  155.     /* initiate all variables otherwise read from the message header data */
  156.  
  157.     EVENT.TYPE = 0 /* entermsg */
  158.  
  159.     address(bbsread)
  160.     GETBBSLIST stem BBSLIST
  161.     if(rc ~= 0) then
  162.     do
  163.         address(thorport)
  164.         REQUESTNOTIFY TEXT '"'BBSREAD.LASTERROR'"' BT '"_Ok"'
  165.         signal exit
  166.     end
  167.  
  168.     address(thorport)
  169.     REQUESTLIST instem BBSLIST title '"Select BBS:"' SIZEGADGET
  170.     if(rc ~= 0) then signal exit
  171.     else MSG.BBSNAME = result
  172.  
  173.     address(bbsread)
  174.     GETCONFLIST '"'MSG.BBSNAME'"' CONFLIST
  175.     if(rc ~= 0) then
  176.     do
  177.         address(thorport)
  178.         REQUESTNOTIFY TEXT '"'BBSREAD.LASTERROR'"' BT '"_Ok"'
  179.         signal exit
  180.     end
  181.  
  182.     address(thorport)
  183.     REQUESTLIST instem CONFLIST title '"Select conf:"' SIZEGADGET
  184.     if(rc ~= 0) then signal exit
  185.     else EVENT.CONFERENCE = result
  186.  
  187.     REQUESTSTRING TITLE '"Please enter subject of message:"' BT '"_Ok|_Cancel"' ID '"ChessMaster3000"' MAXCHARS 100
  188.     EVENT.SUBJECT = result
  189.     if(rc ~= 0 | EVENT.SUBJECT = "") then signal exit
  190.  
  191.     do forever
  192.         REQUESTSTRING TITLE '"Please enter the name of your opponent:"' BT '"_Ok|_Cancel "' MAXCHARS 200
  193.         if(rc ~= 0) then signal exit
  194.         EVENT.TONAME = result
  195.  
  196.         if(upper(EVENT.TONAME) ~= "ALL") then
  197.         do
  198.             address(bbsread)
  199.             SEARCHBRUSER bbsname '"'MSG.BBSNAME'"' stem USERS search '"'EVENT.TONAME'"' name address alias suggestusersstem SUG
  200.             if(rc ~= 0) then signal exit
  201.  
  202.             if(result > 0) then
  203.             do
  204.                 drop LIST.
  205.                 drop USERTAGS.
  206.  
  207.                 LIST.COUNT = USERS.COUNT
  208.  
  209.                 do n = 1 to USERS.COUNT
  210.                     LIST.n.USERNR = USERS.n.USERNR
  211.  
  212.                     address(bbsread)
  213.                     READBRUSER bbsname '"'MSG.BBSNAME'"' usernr USERS.n.USERNR tagsstem USERTAGS
  214.                     if(rc ~= 0) then signal exit
  215.                     LIST.n = USERTAGS.NAME
  216.  
  217.                     if(symbol("USERTAGS.ADDRESS") = "VAR") then
  218.                         LIST.n.ADDRESS = USERTAGS.ADDRESS
  219.                 end
  220.  
  221.                 address(thorport)
  222.                 REQUESTLIST instem LIST title '"Select user:"'
  223.                 if(rc ~= 0) then
  224.                 do
  225.                     if(rc ~= 5) then REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
  226.                     signal exit
  227.                 end
  228.  
  229.                 EVENT.TONAME = result
  230.  
  231.                 do n = 1 to LIST.COUNT
  232.                     if(LIST.n = EVENT.TONAME) then
  233.                         EVENT.TOADDR = LIST.n.ADDRESS
  234.                 end
  235.                 leave
  236.             end
  237.             else
  238.             do
  239.                 if(symbol("SUG.COUNT") = "VAR") then do
  240.                     address(thorport)
  241.                     REQUESTLIST instem SUG title '"Select user:"'
  242.                     if(rc ~= 0) then
  243.                     do
  244.                         if(rc ~= 5) then REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
  245.                         signal exit
  246.                     end
  247.  
  248.                     EVENT.TONAME = result
  249.  
  250.                     do n = 1 to SUG.COUNT
  251.                         if(SUG.n = EVENT.TONAME) then
  252.                             usernumber = SUG.n.USERNR
  253.                     end
  254.  
  255.                     drop USERTAGS.
  256.  
  257.                     address(bbsread)
  258.                     READBRUSER bbsname '"'MSG.BBSNAME'"' usernr usernumber tagsstem USERTAGS
  259.                     if(rc ~= 0) then signal exit
  260.  
  261.                     if(symbol("USERTAGS.ADDRESS") = "VAR") then
  262.                         EVENT.TOADDR = USERTAGS.ADDRESS
  263.  
  264.                     leave
  265.                 end
  266.                 else
  267.                 do
  268.                     address(thorport)
  269.                     REQUESTNOTIFY TEXT '"No matching users found, try again?"' BT '"_Ok|_Cancel"'
  270.                     if(rc ~= 0) then signal exit
  271.                     if(result = 0) then signal exit
  272.                 end
  273.             end
  274.         end
  275.         else signal exit /* doesn't work with ALL */
  276.     end
  277.  
  278.     blackplayer = EVENT.TONAME
  279. RETURN
  280.  
  281. ReadData:
  282.     roundnumber = substr(line, lastpos('#', line)+1)
  283.  
  284.     /*
  285.  
  286.     Black: Matthias Bartosik
  287.     White: Troels Walsted_Hansen
  288.     */
  289.  
  290.     call readln(ifh)
  291.     blackplayer = substr(readln(ifh), 8)
  292.     whiteplayer = substr(readln(ifh), 8)
  293.  
  294.     /*
  295.  
  296.     Status: White Pawn at H1 exchanged for Bishop
  297.  
  298.          +---+---+---+---+---+---+---+---+
  299.     */
  300.  
  301.     do 4; call readln(ifh); end
  302.  
  303.     /*
  304.        8 | #C# | #N# | #B# | #Q# | #K# | #B# | #N# | #C# |
  305.          +---+-^-+---+-^-+---+-^-+---+-^-+
  306.        7 | #P# | #P# | #P# | #P# | #P# | #P# | #P# | #P# |
  307.          +-^-+---+-^-+---+-^-+---+-^-+---+
  308.        6 |   |   |   |   |   |   |   |   |
  309.          +---+-^-+---+-^-+---+-^-+---+-^-+
  310.        5 |   |   |   |   |   |   |   |   |
  311.          +-^-+---+-^-+---+-^-+---+-^-+---+
  312.        4 |   |   |   |   |   |   |   |   |
  313.          +---+-^-+---+-^-+---+-^-+---+-^-+
  314.        3 |   |   |   |   |   |   |   |   |
  315.          +-^-+---+-^-+---+-^-+---+-^-+---+
  316.        2 | P | P | P | P | P | P | P | P |
  317.          +---+-^-+---+-^-+---+-^-+---+-^-+
  318.        1 | C | N | B | Q | K | B | N | C |
  319.          +-^-+---+-^-+---+-^-+---+-^-+---+
  320.            a   b   c   d   e   f   g   h
  321.  
  322.     Black losses:
  323.     */
  324.  
  325.     line.8 = readln(ifh);        call readln(ifh)
  326.     line.7 = readln(ifh);        call readln(ifh)
  327.     line.6 = readln(ifh);        call readln(ifh)
  328.     line.5 = readln(ifh);        call readln(ifh)
  329.     line.4 = readln(ifh);        call readln(ifh)
  330.     line.3 = readln(ifh);        call readln(ifh)
  331.     line.2 = readln(ifh);        call readln(ifh)
  332.     line.1 = readln(ifh)
  333.  
  334.     do 4; call readln(ifh); end
  335.  
  336.     /*
  337.     #C#, #Q#
  338.  
  339.     White losses:
  340.     B, P, Q
  341.     */
  342.  
  343.     blacklosses = readln(ifh)
  344.     do 2; call readln(ifh); end
  345.     whitelosses = readln(ifh)
  346.  
  347.     call close(ifh)
  348.  
  349.     /* parse the input */
  350.  
  351.     do y=1 to 8
  352.         line.y = delstr(line.y, 1, 6)
  353.  
  354.         do x=1 to 8
  355.             pos.x.y = substr(line.y, 1, pos('|', line.y)-1)
  356.             line.y = delstr(line.y, 1, pos('|', line.y))
  357.         end
  358.     end
  359. RETURN
  360.  
  361. PlayMove:
  362.     /* determine who the current player is */
  363.  
  364.     address(thorport)
  365.     CURRENTBBS stem CURRENT
  366.     if(rc ~= 0) then
  367.     do
  368.         address(thorport)
  369.         REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
  370.         signal exit
  371.     end
  372.  
  373.     address(bbsread)
  374.     GETBBSDATA bbsname '"'CURRENT.BBSNAME'"' stem BBSDATA
  375.     if(rc ~= 0) then
  376.     do
  377.         address(thorport)
  378.         REQUESTNOTIFY TEXT '"'BBSREAD.LASTERROR'"' BT '"_Ok"'
  379.         signal exit
  380.     end
  381.  
  382.     if(BBSDATA.USERNAME = '') then
  383.     do
  384.         GETGLOBALDATA stem GLOBALDATA
  385.             if(rc ~= 0) then
  386.             do
  387.                 address(thorport)
  388.                 REQUESTNOTIFY TEXT '"'BBSREAD.LASTERROR'"' BT '"_Ok"'
  389.                 signal exit
  390.             end
  391.  
  392.         if(GLOBALDATA.USERNAME = '') then signal exit
  393.         else username = GLOBALDATA.USERNAME
  394.     end
  395.     else username = BBSDATA.USERNAME
  396.  
  397.     if(newgame) then whiteplayer = username
  398.  
  399.     select
  400.         when(username = blackplayer) then
  401.         do
  402.             color = 'Black'
  403.             othercolor = 'White'
  404.         end
  405.  
  406.         when(username = whiteplayer) then
  407.         do
  408.             color = 'White'
  409.             othercolor = 'Black'
  410.         end
  411.  
  412.         otherwise signal exit
  413.     end
  414.  
  415.     /* ask user to specify move */
  416.  
  417.     exchangepawn = 0
  418.     longcastle = 0
  419.     shortcastle = 0
  420.     passant = 0
  421.  
  422.     address(thorport)
  423.     REQUESTSTRING TITLE '"ChessMaster3000"' BODY '"' || color || ' player enter your move\non the form ''xyxy''.' || '"' BT '"_Ok|_Special move|_Cancel"' MAXCHARS 4
  424.     if(rc ~= 0) then signal exit
  425.  
  426.     /* normal move */
  427.  
  428.     if(result ~= '') then
  429.     do
  430.         origmovestr = upper(result)
  431.  
  432.         movestr = translate(origmovestr, '12345678', 'ABCDEFGH')
  433.  
  434.         fromxpos = substr(movestr, 1, 1);    fromypos = substr(movestr, 2, 1)
  435.         toxpos = substr(movestr, 3, 1);        toypos = substr(movestr, 4, 1)
  436.  
  437.         /* verify the integrity of the coordinates */
  438.  
  439.         select
  440.             when(fromxpos > 8 | fromxpos < 1) then errormsg = 'FROM x-coordinate out of range.'
  441.             when(fromypos > 8 | fromypos < 1) then errormsg = 'FROM y-coordinate out of range.'
  442.             when(toxpos > 8 | toxpos < 1) then errormsg = 'TO x-coordinate out of range.'
  443.             when(toypos > 8 | toypos < 1) then errormsg = 'TO y-coordinate out of range.'
  444.             when(pos.fromxpos.fromypos = '   ') then errormsg = 'Invalid FROM coordinates, no chess piece found.'
  445.             when(left(strip(pos.fromxpos.fromypos, B), 1) = '#' & color = 'White' | left(strip(pos.fromxpos.fromypos, B), 1) ~= '#' & color = 'Black') then errormsg = 'Invalid FROM coordinates, trying to\nmove other player''s chess piece.'
  446.             when(pos.toxpos.toypos ~= '   ' & left(strip(pos.toxpos.toypos, B), 1) ~= '#' & color = 'White' | left(strip(pos.toxpos.toypos, B), 1) = '#' & color = 'Black') then errormsg = 'TO square is occupied by your own piece.'
  447.             otherwise errormsg = ''
  448.         end
  449.  
  450.         if(errormsg ~= '') then
  451.         do
  452.             address(thorport)
  453.             REQUESTNOTIFY TEXT '"'errormsg'"' BT '"_Ok"'
  454.             signal exit
  455.         end
  456.  
  457.         /* determine whether an enemy piece has been beaten */
  458.  
  459.         frompiece = compress(pos.fromxpos.fromypos, '# ')
  460.         topiece = compress(pos.toxpos.toypos, '# ')
  461.  
  462.         if(pos.toxpos.toypos ~= '   ') then
  463.         do
  464.             if(topiece = 'K') then
  465.             do
  466.                 address(thorport)
  467.                 do 50; BEEP; end
  468.                 REQUESTNOTIFY TEXT '"You have won the game!"' BT '"H_ooya!"'
  469.                 /* gotta post a fancy message here */
  470.                 signal exit
  471.             end
  472.  
  473.             if(color = 'Black') then whitelosses = whitelosses || ', ' || strip(pos.toxpos.toypos, B)
  474.             else blacklosses = blacklosses || ', ' || strip(pos.toxpos.toypos, B)
  475.  
  476.             select
  477.                 when(left(blacklosses, 1) = ',') then blacklosses = substr(blacklosses, 3)
  478.                 when(left(whitelosses, 1) = ',') then whitelosses = substr(whitelosses, 3)
  479.                 otherwise nop
  480.             end
  481.         end
  482.         else anyonebeaten = 'FALSE'
  483.  
  484.         /* move the piece to the TO square and clear the FROM square */
  485.  
  486.         pos.toxpos.toypos = pos.fromxpos.fromypos
  487.         pos.fromxpos.fromypos = '   '
  488.     end
  489.     else    /* special move */
  490.     do
  491.         address(thorport)
  492.         REQUESTNOTIFY TEXT '"Select special move:"' BT '"_Exchange Pawn|C_astle|_Passant|_Cancel"'
  493.         if(rc ~= 0) then signal exit
  494.  
  495.         select
  496.             when(result = 0) then signal exit    /* Cancel             */
  497.             when(result = 1) then                /* Exchange Pawn     */
  498.             do
  499.                 exchangepawn = 1
  500.  
  501.                 if(color = 'Black') then y = 1
  502.                 else y = 8
  503.  
  504.                 availpawn.count = 0
  505.  
  506.                 do x=1 to 8
  507.                     if(compress(pos.x.y, '# ') = 'P') then
  508.                     do
  509.                         availpawn.count = availpawn.count+1
  510.                         k = availpawn.count
  511.                         availpawn.k = translate(x, 'ABCDEFGH', '12345678') || y
  512.                     end
  513.                 end
  514.  
  515.                 if(availpawn.count = 0) then
  516.                 do
  517.                     address(thorport)
  518.                     REQUESTNOTIFY TEXT '"No Pawn-exchanging is possible."' BT '"_Ok"'
  519.                     signal exit
  520.                 end
  521.  
  522.                 if(availpawn.count ~= 1) then
  523.                 do
  524.                     /* change to REQUESTNOTIFY !? */
  525.                     address(thorport)
  526.                     REQUESTLIST TITLE '"Choose one set of coordinates"' instem availpawn SIZEGADGET
  527.                     if(rc ~= 0) then signal exit
  528.  
  529.                     pawncoord = result
  530.                 end
  531.                 else pawncoord = availpawn.1
  532.  
  533.                 address(thorport)
  534.                 REQUESTNOTIFY TEXT '"Select new chess piece:"' BT '"_Queen|_Bishop|K_night|_Castle"'
  535.                 if(rc ~= 0) then signal exit
  536.  
  537.                 select
  538.                     when(result = 0) then signal exit
  539.                     when(result = 1) then frompiece = 'Q'
  540.                     when(result = 2) then frompiece = 'B'
  541.                     when(result = 3) then frompiece = 'N'
  542.                     when(result = 4) then frompiece = 'C'
  543.                     otherwise frompiece = 'P'
  544.                 end
  545.  
  546.                 if(color = 'Black') then styledfrompiece = ' #' || frompiece || '# '
  547.                 else styledfrompiece = ' ' || frompiece || ' '
  548.  
  549.                 x = translate(left(pawncoord, 1), '12345678', 'ABCDEFGH')
  550.                 y = right(pawncoord, 1)
  551.  
  552.                 pos.x.y = styledfrompiece
  553.             end
  554.  
  555.             when(result = 2) then        /* Castle            */
  556.             do
  557.                 if(color = 'Black') then y = 8
  558.                 else y = 1
  559.  
  560.                 if(compress(pos.1.y, '# ') = 'C' & pos.2.y = '   ' & pos.3.y = '   ' & pos.4.y = '   ' & compress(pos.5.y, '# ') = 'K') then longcastle = 1
  561.                 if(compress(pos.5.y, '# ') = 'K' & pos.6.y = '   ' & pos.7.y = '   ' & compress(pos.8.y, '# ') = 'C') then shortcastle = 1
  562.  
  563.                 if(longcastle = 0 & shortcastle = 0) then
  564.                 do
  565.                     address(thorport)
  566.                     REQUESTNOTIFY TEXT '"You cannot perform a castling."' BT '"_Ok"'
  567.                     signal exit
  568.                 end
  569.  
  570.                 gadstr = ''
  571.  
  572.                 if(longcastle = 1 & shortcastle = 1) then
  573.                 do
  574.                     address(thorport)
  575.                     REQUESTNOTIFY TEXT '"Select which kind of castling:"' BT '"_Long|_Short|_Cancel"'
  576.                     if(rc ~= 0) then signal exit
  577.  
  578.                     if(result = 1) then shortcastle = 0
  579.                     else longcastle = 0
  580.                 end
  581.  
  582.                 /* style 'em */
  583.  
  584.                 if(color = 'Black') then
  585.                 do
  586.                     styledking = ' #K# '
  587.                     styledcastle = ' #C# '
  588.                 end
  589.                 else
  590.                 do
  591.                     styledking = ' K '
  592.                     styledcastle = ' C '
  593.                 end
  594.  
  595.                 select
  596.                     when(longcastle = 1) then
  597.                     do
  598.                         pos.1.y = '   ';        pos.5.y = '   '
  599.                         pos.3.y = styledking;    pos.4.y = styledcastle
  600.                     end
  601.  
  602.                     when(shortcastle = 1) then
  603.                     do
  604.                         pos.8.y = '   ';        pos.5.y = '   '
  605.                         pos.7.y = styledking;    pos.6.y = styledcastle
  606.                     end
  607.  
  608.                     otherwise signal exit
  609.                 end
  610.             end
  611.  
  612.             when(result = 3) then        /* Passant            */
  613.             do
  614.                 passant = 1
  615.  
  616.                 /* beating 'en passant' may happen only if two opponent pawns are
  617.                    standing next to each other on either y=5 | y=4. */
  618.  
  619.                 if(color  = 'Black') then y = 4
  620.                 else y = 5
  621.  
  622.                 availpassant.count = 0
  623.  
  624.                 do x=1 to 8
  625.                     k = x+1
  626.                     if(pos.x.y = ' P ' & pos.k.y = ' #P# ' | pos.x.y = ' #P# ' & pos.k.y = ' P ') then
  627.                     do
  628.                         /* determine which one belongs to the current player */
  629.                         select
  630.                             when(pos.x.y = ' P ' & color = 'White') then
  631.                             do
  632.                                 passantkillercolor = 'White'
  633.                                 passantvictimcolor = 'Black'
  634.                                 passantkillerx = x
  635.                                 passantvictimx = k
  636.                             end
  637.  
  638.                             when(pos.k.y = ' P ' & color = 'White') then
  639.                             do
  640.                                 passantkillercolor = 'White'
  641.                                 passantvictimcolor = 'Black'
  642.                                 passantkillerx = k
  643.                                 passantvictimx = x
  644.                             end
  645.  
  646.                             when(pos.x.y = ' #P# ' & color = 'Black') then
  647.                             do
  648.                                 passantkillercolor = 'Black'
  649.                                 passantvictimcolor = 'White'
  650.                                 passantkillerx = x
  651.                                 passantvictimx = k
  652.                             end
  653.  
  654.                             when(pos.k.y = ' #P# ' & color = 'Black') then
  655.                             do
  656.                                 passantkillercolor = 'Black'
  657.                                 passantvictimcolor = 'White'
  658.                                 passantkillerx = k
  659.                                 passantvictimx = x
  660.                             end
  661.  
  662.                             otherwise signal exit
  663.                         end
  664.  
  665.                         /* determine whether the appropriate squares are open */
  666.  
  667.                         if(passantkillercolor = 'Black' & pos.passantvictimx.2 = '   ' & pos.passantvictimx.3 = '   ' | passantkillercolor = 'White' & pos.passantvictimx.6 = '   ' & pos.passantvictimx.7 = '   ') then
  668.                         do
  669.                             availpassant.count = availpassant.count+1
  670.                             j = availpassant.count
  671.                             availpassant.j = translate(passantkillerx, 'ABCDEFGH', '12345678') || y || ' beating ' || translate(passantvictimx, 'ABCDEFGH', '12345678') || y
  672.                         end
  673.                     end
  674.                 end
  675.  
  676.                 if(availpassant.count = 0) then
  677.                 do
  678.                     address(thorport)
  679.                     REQUESTNOTIFY TEXT '"No passant opportunities available."' BT '"_Ok"'
  680.                     signal exit
  681.                 end
  682.  
  683.                 if(availpassant.count ~= 1) then
  684.                 do
  685.                     address(thorport)
  686.                     REQUESTLIST TITLE '"Choose one scenario:"' instem availpassant SIZEGADGET
  687.                     if(rc ~= 0) then signal exit
  688.  
  689.                     passantcoord = result
  690.                 end
  691.                 else passantcoord = availpassant.1
  692.  
  693.                 toxpos = translate(substr(passantcoord, 12, 1), '12345678', 'ABCDEFGH')
  694.  
  695.                 if(color = 'Black') then whitelosses = whitelosses || ', ' || strip(pos.toxpos.y, B)
  696.                 else blacklosses = blacklosses || ', ' || strip(pos.toxpos.y, B)
  697.  
  698.                 select
  699.                     when(left(blacklosses, 1) = ',') then blacklosses = substr(blacklosses, 3)
  700.                     when(left(whitelosses, 1) = ',') then whitelosses = substr(whitelosses, 3)
  701.                     otherwise nop
  702.                 end
  703.  
  704.                 /* clear the TO square */
  705.  
  706.                 pos.toxpos.y = '   '
  707.                 passantcoord = right(passantcoord, 2)
  708.             end
  709.  
  710.             otherwise signal exit        /* just in case        */
  711.         end
  712.     end
  713.  
  714.     roundnumber = roundnumber+1
  715. RETURN
  716.  
  717. WriteData:
  718.     /* write the whole thing to a temp file */
  719.  
  720.     call open(ofh, 'T:ChessMaster3000.thor.temp', W)
  721.  
  722.     call writeln(ofh, '***ChessMaster3000, round #' || roundnumber)
  723.     call writeln(ofh, '')
  724.     call writeln(ofh, 'Black: ' || blackplayer)
  725.  
  726.     if(firstmove) then whiteplayer = 'You.'
  727.  
  728.     call writeln(ofh, 'White: ' || whiteplayer)
  729.     call writeln(ofh, '')
  730.  
  731.     select
  732.         when(topiece = 'K') then str = ' King'
  733.         when(topiece = 'Q') then str = ' Queen'
  734.         when(topiece = 'C') then str = ' Castle'
  735.         when(topiece = 'N') then str = ' Knight'
  736.         when(topiece = 'B') then str = ' Bishop'
  737.         when(topiece = 'P') then str = ' Pawn'
  738.         otherwise str = ' Unknown'
  739.     end
  740.  
  741.     if(anyonebeaten ~= 'FALSE') then beatenstr = ' beating ' || othercolor || str
  742.     else beatenstr = ''
  743.  
  744.     select
  745.         when(frompiece = 'K') then str = ' King '
  746.         when(frompiece = 'Q') then str = ' Queen '
  747.         when(frompiece = 'C') then str = ' Castle '
  748.         when(frompiece = 'N') then str = ' Knight '
  749.         when(frompiece = 'B') then str = ' Bishop '
  750.         when(frompiece = 'P') then str = ' Pawn '
  751.         otherwise str = ' Unknown '
  752.     end
  753.  
  754.     select
  755.         when(firstmove)        then     statstr = 'Status: Waiting for your first move.'
  756.         when(exchangepawn)    then    statstr = 'Status: ' || color || ' Pawn at ' || pawncoord || ' exchanged for' || str
  757.         when(longcastle)    then    statstr = 'Status: ' || color || ' performed a long castling'
  758.         when(shortcastle)    then    statstr = 'Status: ' || color || ' performed a short castling'
  759.         when(passant)        then     statstr = 'Status: ' || color || ' Pawn beat a ' || othercolor || ' Pawn en passant at ' || passantcoord
  760.         otherwise                    statstr = 'Status: ' || color || str || 'from ' || left(origmovestr, 2) || ' to ' || right(origmovestr, 2) || beatenstr
  761.     end
  762.  
  763.     call writeln(ofh, statstr)
  764.     call writeln(ofh, '')
  765.     call writeln(ofh, '     +---+---+---+---+---+---+---+---+')
  766.  
  767.     do y=8 to 1 by -1
  768.         call writeln(ofh, '   ' || y || ' |' || pos.1.y || '|' || pos.2.y || '|' || pos.3.y || '|' || pos.4.y || '|' || pos.5.y || '|' || pos.6.y || '|' || pos.7.y || '|' || pos.8.y || '|')
  769.         if(y//2 = 0) then str = '     +---+-^-+---+-^-+---+-^-+---+-^-+'
  770.         else str = '     +-^-+---+-^-+---+-^-+---+-^-+---+'
  771.         call writeln(ofh, str)
  772.     end
  773.  
  774.     call writeln(ofh, '       a   b   c   d   e   f   g   h')
  775.     call writeln(ofh, '')
  776.     call writeln(ofh, 'Black losses:')
  777.     call writeln(ofh, blacklosses)
  778.     call writeln(ofh, '')
  779.     call writeln(ofh, 'White losses:')
  780.     call writeln(ofh, whitelosses)
  781.     call writeln(ofh, '')
  782.     call writeln(ofh, 'K = King      B = Bishop     C = Castle')
  783.     call writeln(ofh, 'Q = Queen     N = Knight     P = Pawn')
  784.  
  785.     call close(ofh)
  786. RETURN
  787.  
  788. PostMsg:
  789.     address(bbsread)
  790.     UNIQUEMSGFILE bbsname '"'MSG.BBSNAME'"' stem UNIQUEFILE
  791.     if(rc ~= 0) then
  792.     do
  793.         address(thorport)
  794.         REQUESTNOTIFY TEXT '"'BBSREAD.LASTERROR'"' BT '"_Ok"'
  795.         signal exit
  796.     end
  797.  
  798.     address command 'copy >nil: T:ChessMaster3000.thor.temp TO ' || UNIQUEFILE.NAME
  799.     EVENT.MSGFILE = UNIQUEFILE.FILEPART
  800.  
  801.     address(bbsread)
  802.     WRITEBREVENT bbsname '"'MSG.BBSNAME'"' event EVENT.TYPE stem EVENT
  803.     if(rc ~= 0) then
  804.     do
  805.         address(thorport)
  806.         REQUESTNOTIFY TEXT '"'BBSREAD.LASTERROR'"' BT '"_Ok"'
  807.         signal exit
  808.     end
  809.  
  810.     address(thorport)
  811.     REQUESTNOTIFY TEXT '"Edit message?"' BT '"_Yes|_No"'
  812.     if(result = 1) then STARTEDITOR FILE '"'UNIQUEFILE.NAME'"'
  813. RETURN
  814.  
  815. signal exit:
  816.     address command 'delete T:ChessMaster3000.thor.temp quiet'
  817.     exit
  818.